Métodos de Predictivos (Clasificación o Aprendizaje-Supervisado)

Índices de Calidad del Modelo y funciones auxiliares

library(tidyverse)

── Attaching packages ─────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse 1.2.1 ──

✔ ggplot2 3.2.0     ✔ purrr   0.3.2
✔ tibble  2.1.3     ✔ dplyr   0.8.3
✔ tidyr   0.8.3     ✔ stringr 1.4.0
✔ readr   1.3.1     ✔ forcats 0.4.0

── Conflicts ────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()

library(glue)

Attaching package: 'glue'

The following object is masked from 'package:dplyr':

    collapse

library(scales)

Attaching package: 'scales'

The following object is masked from 'package:purrr':

    discard

The following object is masked from 'package:readr':

    col_factor

equilibrio.variable.predecir <- function(datos, variable.predecir, ylab = "Cantidad de individuos", 
                                        xlab = "", main = paste("Distribución de la variable",variable.predecir), col = NA) {
  gg_color <- function (n) {
     hues <- seq(15, 375, length = n + 1)
     hcl(h = hues, l = 65, c = 100)[1:n]
  }
  if(missing(variable.predecir) | !(variable.predecir %in% colnames(datos))){
    stop("variable.predecir tiene que ser ingresada y ser un nombre de columna", call. = FALSE )
  }
  if(is.character(datos[,variable.predecir]) | is.factor(datos[,variable.predecir])){
    if(length(col) == 0 || is.na(col)){
      col <- gg_color(length(unique(datos[,variable.predecir])))
    }else{
      col <- rep(col,length(unique(datos[,variable.predecir])))
    }
    ggplot(data = datos, mapping = aes_string(x = variable.predecir, fill = variable.predecir)) +
      geom_bar() +
      scale_fill_manual(values = col, name = variable.predecir) +
      labs(x = xlab, y = ylab, title = main) +
      theme_minimal() +
      theme(legend.position = "bottom")
  }else{
    stop("La variable a predecir tienen que ser de tipo factor o character", call. = FALSE )
  }
}

poder.predictivo.numerica <- function(datos, variable.predecir, variable.comparar, ylab = "", 
                                       xlab = "", main = paste("Densidad de la variable", variable.comparar, 'según', variable.predecir), col = NA){
  gg_color <- function (n) {
     hues <- seq(15, 375, length = n + 1)
     hcl(h = hues, l = 65, c = 100)[1:n]
  }
  if(missing(variable.predecir) | !(variable.predecir %in% colnames(datos))){
    stop("variable.predecir tiene que ser ingresada y ser un nombre de columna", call. = FALSE )
  }
  if(missing(variable.comparar) | !(variable.comparar %in% colnames(datos)) | !is.numeric(datos[,variable.comparar])){
    stop("variable.comparar tiene que ser ingresada y ser un nombre de columna numérica", call. = FALSE )
  }
  
  if(is.character(datos[,variable.predecir]) | is.factor(datos[,variable.predecir])){
    if(length(col) == 0 || is.na(col)){
      col <- gg_color(length(unique(datos[,variable.predecir])))
    }else{
      col <- rep(col,length(unique(datos[,variable.predecir])))
    }
    
    ggplot(data = datos, aes_string(variable.comparar, fill = variable.predecir)) +
      geom_density(alpha = .7, color = NA) +
      scale_fill_manual(values = col) +
      labs(title = main , y = ylab, x = xlab ,fill = variable.predecir) +
      theme_minimal() +
      theme(legend.position = 'bottom',
            legend.title = element_blank(),
            text = element_text(size = 15))
    
  }else{
    stop("La variable a predecir tienen que ser de tipo factor o character", call. = FALSE )
  }
}

poder.predictivo.categorica <- function(datos, variable.predecir, variable.comparar, ylab = "", 
                                        xlab = "", main = paste("Densidad de la variable", variable.comparar, 'según', variable.predecir), col = NA) {
  gg_color <- function (n) {
     hues <- seq(15, 375, length = n + 1)
     hcl(h = hues, l = 65, c = 100)[1:n]
  }
  if(missing(variable.predecir) | !(variable.predecir %in% colnames(datos))){
    stop("variable.predecir tiene que ser ingresada y ser un nombre de columna", call. = FALSE )
  }
  if(missing(variable.comparar) | !(variable.comparar %in% colnames(datos)) | 
     !(is.factor(datos[,variable.comparar]) | is.character(datos[,variable.comparar])) ){
    stop("variable.comparar tiene que ser ingresada y ser un nombre de columna categórica", call. = FALSE )
  }
  
  if(is.character(datos[,variable.predecir]) | is.factor(datos[,variable.predecir])){
    if(length(col) == 0 || is.na(col)){
      col <- gg_color(length(unique(datos[,variable.predecir])))
    }else{
      col <- rep(col,length(unique(datos[,variable.predecir])))
    }
    
    datos2 <- datos %>%
      dplyr::group_by_(variable.comparar, variable.predecir) %>%
      dplyr::summarise(count = n())
    
    if(variable.comparar != variable.predecir){
      datos2 <-   datos2 %>% dplyr::group_by_(variable.comparar)
    }
    datos2 <- datos2 %>% dplyr::mutate(prop = round(count/sum(count),4))
  
    ggplot(data = datos2, mapping = aes_string(x = variable.comparar, y = "prop", fill = variable.predecir)) +
      geom_col(position = "fill") +
      geom_text(aes(label = glue("{percent(prop)} ({count})")), position = position_stack(vjust = .5), color = "white") +
      scale_y_continuous(label = percent) +
      labs(y =  xlab, x  = ylab, title = main) +
      scale_fill_manual(values = col, name = variable.predecir) +
      theme(legend.position = "bottom")+
      coord_flip()
    
  }else{
    stop("La variable a predecir tienen que ser de tipo factor o character", call. = FALSE )
  }
}

# Índices para matrices NxN
indices.general <- function(MC) {
  precision.global <- sum(diag(MC))/sum(MC)
  error.global <- 1 - precision.global
  precision.categoria <- diag(MC)/rowSums(MC)
  res <- list(matriz.confusion = MC, precision.global = precision.global, error.global = error.global, 
              precision.categoria = precision.categoria)
  names(res) <- c("Matriz de Confusión", "Precisión Global", "Error Global", 
                  "Precisión por categoría")
  return(res)
}

El método Árboles de Decisión

Ejemplo Iris

Distribución de las clases

setwd("~/Desktop/Datos/")
datos<-read.csv("iris.csv",sep = ";",dec='.',header=T)
equilibrio.variable.predecir(datos,"tipo")

Predicción

setwd("~/Desktop/Datos/")
datos <- read.csv("iris.csv",sep = ";",dec='.',header=T)

## Vamos a generar al azar una tabla de testing de tamaño 50 y una tabla de aprendizaje de tamaño 100.
muestra <- sample(1:nrow(datos), 50)
ttesting <- datos[muestra,]
taprendizaje <- datos[-muestra,]

library(rpart)
library(rpart.plot)

# Genera el modelo
modelo <- rpart(tipo~., data = taprendizaje)

# Type="class" hace que el modelo prediga clases y no valores de Regresión
# pues lo árboles pueden ser usados para regresión
prediccion <- predict(modelo, ttesting, type='class')
prp(modelo, extra=104, branch.type = 2, box.col = c("pink", "palegreen3", "cyan")[modelo$frame$yval])

# Prediccion y Matriz de Confusión
MC <- table(ttesting$tipo,prediccion)

# Índices de Calidad de la predicción
indices.general(MC)

$`Matriz de Confusión`
            prediccion
             setosa versicolor virginica
  setosa         13          0         0
  versicolor      0         14         3
  virginica       0          1        19

$`Precisión Global`
[1] 0.92

$`Error Global`
[1] 0.08

$`Precisión por categoría`
    setosa versicolor  virginica 
 1.0000000  0.8235294  0.9500000 

library(trainR)

# Genera el modelo
modelo <- train.rpart(tipo~., data = taprendizaje)

prediccion <- predict(modelo, ttesting)
prp(modelo, extra=104, branch.type = 2, box.col = c("pink", "palegreen3", "cyan")[modelo$frame$yval])

# Prediccion y Matriz de Confusión
MC <- confusion.matrix(ttesting, prediccion)

# Índices de calidad de la predicción
general.indexes(mc = MC)

Confusion Matrix:
            prediction
real         setosa versicolor virginica
  setosa         13          0         0
  versicolor      0         14         3
  virginica       0          1        19

Overall Accuracy: 0.9200
Overall Error:    0.0800

Category Accuracy:

       setosa   versicolor    virginica
     1.000000     0.823529     0.950000

## Generar el árbol cambiando la cantidad mínima de individuos en los nodos hoja (terminales). 
## Es decir, modificando el parámetro "minsplit = 20"
# Un individuos máximo en los nodos terminales
modelo <- rpart(tipo~.,data=taprendizaje,minsplit=2)

# Type="class" hace que el modelo prediga clases y no valores de Regresión
# pues lo árboles pueden ser usados para regresión
prediccion <- predict(modelo, ttesting, type='class')
prp(modelo,extra=104,branch.type=2, box.col=c("pink", "palegreen3","cyan")[modelo$frame$yval])

MC<-table(ttesting$tipo,prediccion)

# Índices de Calidad de la predicción
indices.general(MC)

$`Matriz de Confusión`
            prediccion
             setosa versicolor virginica
  setosa         13          0         0
  versicolor      0         14         3
  virginica       0          1        19

$`Precisión Global`
[1] 0.92

$`Error Global`
[1] 0.08

$`Precisión por categoría`
    setosa versicolor  virginica 
 1.0000000  0.8235294  0.9500000 

library(trainR)

# Genera el modelo
modelo <- train.rpart(tipo~., data = taprendizaje, minsplit = 2)

prediccion <- predict(modelo, ttesting)
prp(modelo, extra=104, branch.type = 2, box.col = c("pink", "palegreen3", "cyan")[modelo$frame$yval])

# Prediccion y Matriz de Confusión
MC <- confusion.matrix(ttesting, prediccion)

# Índices de calidad de la predicción
general.indexes(mc = MC)

Confusion Matrix:
            prediction
real         setosa versicolor virginica
  setosa         13          0         0
  versicolor      0         14         3
  virginica       0          1        19

Overall Accuracy: 0.9200
Overall Error:    0.0800

Category Accuracy:

       setosa   versicolor    virginica
     1.000000     0.823529     0.950000

Selección de Variables

library(ggplot2)
setwd("~/Desktop/Datos/")
datos<-read.csv("iris.csv",sep = ";",dec='.',header=T)

poder.predictivo.numerica(datos, "tipo","s.largo")

poder.predictivo.numerica(datos, "tipo","s.ancho")

poder.predictivo.numerica(datos, "tipo","p.largo")

poder.predictivo.numerica(datos, "tipo","p.ancho")

Predicción con selección de variables

setwd("~/Desktop/Datos/")
datos <- read.csv("iris.csv",sep = ";",dec='.',header=T)

## Vamos a generar al azar una tabla de testing de tamaño 50 y una tabla de aprendizaje de tamaño 100.
muestra <- sample(1:nrow(datos), 50)
ttesting <- datos[muestra,]
taprendizaje <- datos[-muestra,]

library(kknn)

Attaching package: 'kknn'

The following objects are masked from 'package:trainR':

    contr.dummy, contr.ordinal

## Generar el árbol cambiando la cantidad mínima de individuos en los nodos hoja (terminales). 
## Es decir, modificando el parámetro "minsplit = 20"
# Un individuos máximo en los nodos terminales
modelo <- rpart(tipo~p.largo+p.ancho,data=taprendizaje, minsplit=2)

# Type="class" hace que el modelo prediga clases y no valores de Regresión
# pues lo árboles pueden ser usados para regresión
prediccion <- predict(modelo, ttesting, type='class')
prp(modelo,extra=104,branch.type=2, box.col=c("pink", "palegreen3","cyan")[modelo$frame$yval])

MC<-table(ttesting$tipo,prediccion)

# Índices de Calidad de la predicción
indices.general(MC)

$`Matriz de Confusión`
            prediccion
             setosa versicolor virginica
  setosa         19          0         0
  versicolor      0         16         0
  virginica       0          2        13

$`Precisión Global`
[1] 0.96

$`Error Global`
[1] 0.04

$`Precisión por categoría`
    setosa versicolor  virginica 
 1.0000000  1.0000000  0.8666667 

library(trainR)

## Generar el árbol cambiando la cantidad mínima de individuos en los nodos hoja (terminales). 
## Es decir, modificando el parámetro "minsplit = 20"
# Un individuos máximo en los nodos terminales
modelo <- train.rpart(tipo~p.largo+p.ancho,data=taprendizaje, minsplit=2)

# Type="class" hace que el modelo prediga clases y no valores de Regresión
# pues lo árboles pueden ser usados para regresión
prediccion <- predict(modelo, ttesting)
prp(modelo, extra = 104, branch.type = 2, box.col = c("pink", "palegreen3","cyan")[modelo$frame$yval])

MC <- confusion.matrix(ttesting, prediccion)

# Índices de Calidad de la predicción
general.indexes(mc = MC)

Confusion Matrix:
            prediction
real         setosa versicolor virginica
  setosa         19          0         0
  versicolor      0         16         0
  virginica       0          2        13

Overall Accuracy: 0.9600
Overall Error:    0.0400

Category Accuracy:

       setosa   versicolor    virginica
     1.000000     1.000000     0.866667

Ejemplo Scoring

Distribución de las clases

setwd("~/Desktop/Datos/")
datos<-read.csv("MuestraCredito5000V2.csv",sep = ";",header=T)
equilibrio.variable.predecir(datos,"BuenPagador")

Predicción

setwd("~/Desktop/Datos/")
datos<-read.csv("MuestraCredito5000V2.csv",sep = ";",header=T)

# Recodifica las variables como categóricas ordinales
datos$IngresoNeto <- factor(datos$IngresoNeto, ordered = TRUE)
datos$CoefCreditoAvaluo <- factor(datos$CoefCreditoAvaluo, ordered = TRUE)
str(datos)

'data.frame':   5000 obs. of  6 variables:
 $ MontoCredito     : int  14327 111404 21128 15426 10351 27060 243369 16300 18319 107037 ...
 $ IngresoNeto      : Ord.factor w/ 2 levels "1"<"2": 1 1 1 2 1 1 1 2 2 2 ...
 $ CoefCreditoAvaluo: Ord.factor w/ 12 levels "1"<"2"<"3"<"4"<..: 1 1 1 1 1 1 1 1 1 1 ...
 $ MontoCuota       : Factor w/ 4 levels "Alto","Bajo",..: 4 4 4 4 4 4 4 4 4 4 ...
 $ GradoAcademico   : Factor w/ 2 levels "Bachiller","Licenciatura": 1 1 1 1 1 1 1 1 1 1 ...
 $ BuenPagador      : Factor w/ 2 levels "No","Si": 2 2 2 2 2 2 2 2 2 2 ...

## Vamos a generar al azar una tabla de testing con 15% de los datos y una tabla de aprendizaje  con 85%
muestra <- sample(1:nrow(datos), floor(nrow(datos)*0.15))
ttesting <- datos[muestra,]
taprendizaje <- datos[-muestra,]

library(rpart)

# Genera el modelo
modelo = rpart(BuenPagador~.,data=taprendizaje,minsplit=2)
prp(modelo, extra = 104,branch.type = 2, box.col=c("pink", "palegreen3")[modelo$frame$yval])

## Prediccion y Matriz de Confusión
prediccion <- predict(modelo, ttesting, type='class')
MC<-table(ttesting$BuenPagador,prediccion)

# Índices de Calidad de la predicción
indices.general(MC)

$`Matriz de Confusión`
    prediccion
      No  Si
  No  67  34
  Si  14 635

$`Precisión Global`
[1] 0.936

$`Error Global`
[1] 0.064

$`Precisión por categoría`
       No        Si 
0.6633663 0.9784284 

library(trainR)

# Genera el modelo
modelo = train.rpart(BuenPagador~., data = taprendizaje, minsplit = 2)
prp(modelo, extra = 104, branch.type = 2, box.col=c("pink", "palegreen3")[modelo$frame$yval])

## Prediccion y Matriz de Confusión
prediccion <- predict(modelo, ttesting)
MC <- confusion.matrix(ttesting, prediccion)

# Índices de Calidad de la predicción
general.indexes(mc = MC)

Confusion Matrix:
    prediction
real  No  Si
  No  67  34
  Si  14 635

Overall Accuracy: 0.9360
Overall Error:    0.0640

Category Accuracy:

           No           Si
     0.663366     0.978428

Selección de Variables

library(ggplot2)
setwd("~/Desktop/Datos/")
datos<-read.csv("MuestraCredito5000V2.csv",sep = ";",header=T)

# Recodifica las variables como categóricas ordinales
datos$IngresoNeto <- factor(datos$IngresoNeto, ordered = TRUE)
datos$CoefCreditoAvaluo <- factor(datos$CoefCreditoAvaluo, ordered = TRUE)
str(datos)

'data.frame':   5000 obs. of  6 variables:
 $ MontoCredito     : int  14327 111404 21128 15426 10351 27060 243369 16300 18319 107037 ...
 $ IngresoNeto      : Ord.factor w/ 2 levels "1"<"2": 1 1 1 2 1 1 1 2 2 2 ...
 $ CoefCreditoAvaluo: Ord.factor w/ 12 levels "1"<"2"<"3"<"4"<..: 1 1 1 1 1 1 1 1 1 1 ...
 $ MontoCuota       : Factor w/ 4 levels "Alto","Bajo",..: 4 4 4 4 4 4 4 4 4 4 ...
 $ GradoAcademico   : Factor w/ 2 levels "Bachiller","Licenciatura": 1 1 1 1 1 1 1 1 1 1 ...
 $ BuenPagador      : Factor w/ 2 levels "No","Si": 2 2 2 2 2 2 2 2 2 2 ...

poder.predictivo.numerica(datos, "BuenPagador","MontoCredito")

poder.predictivo.categorica(datos,"BuenPagador", "CoefCreditoAvaluo")

poder.predictivo.categorica(datos,"BuenPagador", "MontoCuota")

poder.predictivo.categorica(datos,"BuenPagador", "GradoAcademico")

poder.predictivo.categorica(datos,"BuenPagador", "IngresoNeto")

Predicción con selección de variables

setwd("~/Desktop/Datos/")
datos<-read.csv("MuestraCredito5000V2.csv",sep = ";",header=T)

# Recodifica las variables como categóricas ordinales
datos$IngresoNeto <- factor(datos$IngresoNeto, ordered = TRUE)
datos$CoefCreditoAvaluo <- factor(datos$CoefCreditoAvaluo, ordered = TRUE)
str(datos)

'data.frame':   5000 obs. of  6 variables:
 $ MontoCredito     : int  14327 111404 21128 15426 10351 27060 243369 16300 18319 107037 ...
 $ IngresoNeto      : Ord.factor w/ 2 levels "1"<"2": 1 1 1 2 1 1 1 2 2 2 ...
 $ CoefCreditoAvaluo: Ord.factor w/ 12 levels "1"<"2"<"3"<"4"<..: 1 1 1 1 1 1 1 1 1 1 ...
 $ MontoCuota       : Factor w/ 4 levels "Alto","Bajo",..: 4 4 4 4 4 4 4 4 4 4 ...
 $ GradoAcademico   : Factor w/ 2 levels "Bachiller","Licenciatura": 1 1 1 1 1 1 1 1 1 1 ...
 $ BuenPagador      : Factor w/ 2 levels "No","Si": 2 2 2 2 2 2 2 2 2 2 ...

## Vamos a generar al azar una tabla de testing con 15% de los datos y una tabla de aprendizaje  con 85%
muestra <- sample(1:nrow(datos), floor(nrow(datos)*0.15))
ttesting <- datos[muestra,]
taprendizaje <- datos[-muestra,]

library(rpart)

# Genera el modelo
modelo = rpart(BuenPagador~CoefCreditoAvaluo+MontoCuota+GradoAcademico, data = taprendizaje, minsplit = 2)
prp(modelo,extra = 104, branch.type = 2, box.col = c("pink", "palegreen3")[modelo$frame$yval])

## Prediccion y Matriz de Confusión
prediccion <- predict(modelo, ttesting, type='class')
MC<-table(ttesting$BuenPagador,prediccion)

# Índices de Calidad de la predicción
indices.general(MC)

$`Matriz de Confusión`
    prediccion
      No  Si
  No  57  48
  Si   6 639

$`Precisión Global`
[1] 0.928

$`Error Global`
[1] 0.072

$`Precisión por categoría`
       No        Si 
0.5428571 0.9906977 

library(trainR)

# Genera el modelo
modelo = train.rpart(BuenPagador~CoefCreditoAvaluo+MontoCuota+GradoAcademico, data = taprendizaje, minsplit = 2)
prp(modelo, extra = 104, branch.type = 2, box.col=c("pink", "palegreen3")[modelo$frame$yval])

## Prediccion y Matriz de Confusión
prediccion <- predict(modelo, ttesting)
MC <- confusion.matrix(ttesting, prediccion)

# Índices de Calidad de la predicción
general.indexes(mc = MC)

Confusion Matrix:
    prediction
real  No  Si
  No  57  48
  Si   6 639

Overall Accuracy: 0.9280
Overall Error:    0.0720

Category Accuracy:

           No           Si
     0.542857     0.990698